﻿Option Explicit On
Option Strict On

Imports System
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Drawing2D
Imports System.Drawing.Design
Imports System.Windows.Forms.Design

''' <summary>
''' Determines the angle from which "light" shines
''' </summary>
''' <remarks></remarks>
Friend Structure Angle
    Public Const Up As Single = 50.0F
    Public Const Down As Single = Angle.Up + 180.0F
End Structure

Friend Class RoundButton
    Inherits System.Windows.Forms.Button

#Region " Private Members "

    Private m_buttonColor As Color
    Private m_buttonText As String

    Private m_edgeBrush As LinearGradientBrush ' For painting button edges
    Private m_edgeBlend As Blend ' Blend colours for realistic edges
    Private m_edgeColor1 As Color ' Change if button pressed
    Private m_edgeColor2 As Color
    Private m_edgeWidth As Integer ' Width of button edge    
    Private m_buttonPressOffset As Integer ' Offset when button is pressed
    Private m_lightAngle As Single = Angle.Up ' Alter light angle for "Pressed" effect

    Private m_gotFocus As Boolean = False ' Determine if this button has focus
    Private m_labelFont As Font ' Font for label text
    Private m_vs As VerticalString ' Create vertical text for this buttons
    Private m_labelBrush As SolidBrush ' Brush to paint the text
    Private m_labelStrFmt As StringFormat ' Used to align text on the control

    Private m_bpath As GraphicsPath
    Private m_gpath As GraphicsPath

    Private m_DisabledColor As Color = Color.FromArgb(53, 44, 39)

#End Region

#Region " Constructor "

    ''' <summary>
    ''' Default Constructor
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub New()
        Me.Name = "RoundButton"
        Me.Size = New System.Drawing.Size(50, 50) ' Default size of control

        AddHandler MyBase.MouseDown, AddressOf Me.mouseDown
        AddHandler MyBase.MouseUp, AddressOf Me.mouseUp

        AddHandler MyBase.Enter, AddressOf Me.weGotFocus
        AddHandler MyBase.Leave, AddressOf Me.weLostFocus

        AddHandler MyBase.KeyDown, AddressOf Me.keyDown
        AddHandler MyBase.KeyUp, AddressOf Me.keyUp
    End Sub

#End Region

#Region " Public Properties "

    Public Overrides Property Text As String
        Get
            Return m_buttonText
        End Get
        Set(ByVal value As String)
            m_buttonText = value
            Me.Invalidate()
        End Set
    End Property

    Public Property DisabledColor As Color
        Get
            Return m_DisabledColor
        End Get
        Set(ByVal value As Color)
            m_DisabledColor = value
            Me.Invalidate()
        End Set
    End Property

#End Region

#Region " Base draw functions "

    ''' <summary>
    ''' Main Paint Routine
    ''' </summary>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)

        If e Is Nothing Then
            Throw New ArgumentNullException("e")
        End If

        If Me.Enabled = False Then
            m_buttonColor = m_DisabledColor
        Else
            m_buttonColor = Me.BackColor
        End If

        m_edgeColor1 = ControlPaint.Light(m_buttonColor)
        m_edgeColor2 = ControlPaint.Dark(m_buttonColor)

        Dim g As Graphics = e.Graphics
        g.SmoothingMode = SmoothingMode.AntiAlias

        Dim buttonRect As Rectangle = Me.ClientRectangle
        m_edgeWidth = GetEdgeWidth(buttonRect)

        FillBackground(g, buttonRect)

        DrawEdges(g, buttonRect)

        ShrinkShape(g, buttonRect, m_edgeWidth)

        DrawButton(g, buttonRect)

        DrawText(g, buttonRect)

        SetClickableRegion()

    End Sub

    ''' <summary>
    ''' Fill in the control background
    ''' </summary>
    ''' <param name="g">Graphics object</param>
    ''' <param name="rect">Rectangle defining the button background</param>
    ''' <remarks></remarks>
    Protected Sub FillBackground(ByVal g As Graphics, ByVal rect As Rectangle)

        ' Fill in the control with the background colour, to overwrite anything
        ' that may have been drawn already.
        Dim bgRect As Rectangle = rect
        bgRect.Inflate(1, 1)
        Using bgBrush As SolidBrush = New SolidBrush(Color.FromKnownColor(KnownColor.Control))
            bgBrush.Color = Parent.BackColor
            g.FillRectangle(bgBrush, bgRect)
        End Using

    End Sub

    ''' <summary>
    ''' Fill in the button edges
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="edgeRect">Rectangle defining the button edge</param>
    ''' <remarks></remarks>
    Protected Overridable Sub DrawEdges(ByVal g As Graphics, ByRef edgeRect As Rectangle)

        ShrinkShape(g, edgeRect, 1)

        Dim lgbRect As Rectangle = edgeRect
        lgbRect.Inflate(1, 1)
        m_edgeBrush = New LinearGradientBrush(lgbRect, m_edgeColor1, m_edgeColor2, GetLightAngle(m_lightAngle))
        '			// Blend colours for realism
        m_edgeBlend = New Blend()
        m_edgeBlend.Positions = New Single() {0.0F, 0.2F, 0.4F, 0.6F, 0.8F, 1.0F}
        m_edgeBlend.Factors = New Single() {0.0F, 0.0F, 0.2F, 0.4F, 1.0F, 1.0F}
        m_edgeBrush.Blend = m_edgeBlend
        FillShape(g, m_edgeBrush, edgeRect)

    End Sub

    ''' <summary>
    ''' Fill in the main button colour
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="buttonRect">Rectangle defining the button top</param>
    ''' <remarks></remarks>
    Protected Overridable Sub DrawButton(ByVal g As Graphics, ByVal buttonRect As Rectangle)

        BuildGraphicsPath(buttonRect)

        Using pgb As PathGradientBrush = New PathGradientBrush(m_bpath)
            pgb.SurroundColors = New Color() {m_buttonColor}

            buttonRect.Offset(m_buttonPressOffset, m_buttonPressOffset)

            pgb.CenterColor = m_buttonColor

            FillShape(g, pgb, buttonRect)
        End Using

        'If we have focus, draw line around control to indicate this.
        If (m_gotFocus) Then
            DrawFocus(g, buttonRect)
        End If
    End Sub

    ''' <summary>
    ''' Write the text on the button
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="textRect">Rectangle defining the button text area</param>
    ''' <remarks></remarks>
    Protected Sub DrawText(ByVal g As Graphics, ByVal textRect As Rectangle)

        m_labelStrFmt = New StringFormat()
        m_labelBrush = New SolidBrush(Me.ForeColor)
        m_labelFont = Me.Font 'Get the caller-specified font

        m_vs = New VerticalString()
        m_vs.TextSpread = 0.75

        'Check for tall button, and write text vertically if necessary
        Dim verticalText As Boolean = False
        If (textRect.Height > textRect.Width * 2) Then
            verticalText = True
        End If

        'Convert the text alignment from ContentAlignment to StringAlignment
        m_labelStrFmt.Alignment = ConvertToHorAlign(Me.TextAlign)
        m_labelStrFmt.LineAlignment = ConvertToVertAlign(Me.TextAlign)

        'If horizontal text is not horizontally centred,
        'or vertical text is not vertically centred,
        'shrink the rectangle so that the text doesn't stray outside the ellipse
        If ((Not verticalText And (Not m_labelStrFmt.LineAlignment = StringAlignment.Center)) Or (verticalText And (Not m_labelStrFmt.Alignment = StringAlignment.Center))) Then
            textRect.Inflate(-CInt(textRect.Width / 7.5), -CInt(textRect.Height / 7.5))
        End If

        textRect.Offset(m_buttonPressOffset, m_buttonPressOffset) ' Apply the offset if we've been clicked

        'If button is not enabled, "grey out" the text.
        If (Not Me.Enabled) Then
            'Write the white "embossing effect" text at an offset
            textRect.Offset(1, 1)
            m_labelBrush.Color = ControlPaint.LightLight(m_buttonColor)
            'WriteString(verticalText, g, textRect)

            'Restore original text pos, and set text colour to grey.
            textRect.Offset(-1, -1)
            m_labelBrush.Color = Color.Gray
        End If

        'Write the text
        WriteString(verticalText, g, textRect)
    End Sub

#End Region

#Region " Overrideable shape-specific methods "

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="buttonRect"></param>
    ''' <remarks></remarks>
    Protected Overridable Sub BuildGraphicsPath(ByVal buttonRect As Rectangle)
        m_bpath = New GraphicsPath()
        'Adding this second smaller rectangle to the graphics path smooths the edges - don't know why...?
        Dim rect2 As Rectangle = New Rectangle(buttonRect.X - 1, buttonRect.Y - 1, buttonRect.Width + 2, buttonRect.Height + 2)
        AddShape(m_bpath, rect2)
        AddShape(m_bpath, buttonRect)
    End Sub

    ''' <summary>
    ''' Create region the same shape as the button. This will respond to the mouse click
    ''' </summary>
    ''' <remarks></remarks>
    Protected Overridable Sub SetClickableRegion()
        m_gpath = New GraphicsPath()
        m_gpath.AddEllipse(Me.ClientRectangle)
        Me.Region = New Region(m_gpath) ' Click only activates on elipse
    End Sub

    ''' <summary>
    ''' Method to fill the specified rectangle with either LinearGradient or PathGradient
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="brush">Either a PathGradient- or LinearGradientBrush</param>
    ''' <param name="rect">The rectangle bounding the ellipse to be filled</param>
    ''' <remarks></remarks>
    Protected Overridable Sub FillShape(ByVal g As Graphics, ByVal brush As Object, ByVal rect As Rectangle)
        If TypeOf brush Is System.Drawing.Drawing2D.LinearGradientBrush Then
            g.FillEllipse(DirectCast(brush, LinearGradientBrush), rect)
        ElseIf TypeOf brush Is System.Drawing.Drawing2D.PathGradientBrush Then
            g.FillEllipse(DirectCast(brush, PathGradientBrush), rect)
        End If
    End Sub

    ''' <summary>
    ''' Add an ellipse to the Graphics Path
    ''' </summary>
    ''' <param name="gpath">The Graphics Path</param>
    ''' <param name="rect">The rectangle defining the ellipse to be added</param>
    ''' <remarks></remarks>
    Protected Overridable Sub AddShape(ByVal gpath As GraphicsPath, ByVal rect As Rectangle)
        gpath.AddEllipse(rect)
    End Sub

    ''' <summary>
    ''' Draw the specified shape
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="pen">Pen</param>
    ''' <param name="rect">The rectangle bounding the ellipse to be drawn</param>
    ''' <remarks></remarks>
    Protected Overridable Sub DrawShape(ByVal g As Graphics, ByVal pen As Pen, ByVal rect As Rectangle)
        g.DrawEllipse(pen, rect)
    End Sub

    ''' <summary>
    ''' Shrink the shape 
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="rect">The rectangle defining the shape to be shrunk</param>
    ''' <param name="amount">The amount to shrink it by</param>
    ''' <remarks></remarks>
    Protected Overridable Sub ShrinkShape(ByVal g As Graphics, ByRef rect As Rectangle, ByVal amount As Integer)
        rect.Inflate(-amount, -amount)
    End Sub

    ''' <summary>
    ''' Indicate that this button has focus
    ''' </summary>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="rect">The rectangle defining the button face</param>
    ''' <remarks></remarks>
    Protected Overridable Sub DrawFocus(ByVal g As Graphics, ByVal rect As Rectangle)
        rect.Inflate(-2, -2)
        Using Pen As Pen = New Pen(Color.Black)
            Pen.DashStyle = DashStyle.Dot
            DrawShape(g, Pen, rect)
        End Using
    End Sub

    Protected Overridable Sub DrawInnerBevel(ByVal g As Graphics, ByVal rect As Rectangle, ByVal depth As Integer, ByVal buttonColor As Color)

        Dim lightColor As Color = ControlPaint.LightLight(buttonColor)
        Dim darkColor As Color = ControlPaint.Dark(buttonColor)
        Dim bevelBlend As Blend = New Blend()
        bevelBlend.Positions = New Single() {0.0F, 0.2F, 0.4F, 0.6F, 0.8F, 1.0F}
        bevelBlend.Factors = New Single() {0.2F, 0.4F, 0.6F, 0.6F, 1.0F, 1.0F}

        Dim lgbRect As Rectangle = rect
        lgbRect.Inflate(1, 1)

        Using innerBevelBrush As LinearGradientBrush = New LinearGradientBrush(lgbRect, darkColor, lightColor, GetLightAngle(Angle.Up))
            innerBevelBrush.Blend = bevelBlend
            FillShape(g, innerBevelBrush, rect)
        End Using

    End Sub

#End Region

#Region " Helper Functions "

    ''' <summary>
    ''' Calculate light angle depending on proportions of button
    ''' </summary>
    ''' <param name="angle">Angle.Up or Angle.Down enum</param>
    ''' <returns>The angle in degrees</returns>
    ''' <remarks></remarks>
    Private Function GetLightAngle(ByVal angle As Single) As Single
        Dim f As Single = 1 - CSng(Me.Width / Me.Height) ' Calculate proportions of button
        Dim a As Single = angle - (15 * f) ' Move virtual light source accordingly
        Return a
    End Function

    ''' <summary>
    ''' Calculate button edge width depending on button size
    ''' </summary>
    ''' <param name="rect">Rectangle defining the button</param>
    ''' <returns>The width of the edge</returns>
    ''' <remarks></remarks>
    Private Shared Function GetEdgeWidth(ByVal rect As Rectangle) As Integer
        If (rect.Width < 50 Or rect.Height < 50) Then
            Return 1
        Else
            Return 2
        End If
    End Function

    ''' <summary>
    ''' Write the string using Graphics.Draw or VerticalString.Draw
    ''' </summary>
    ''' <param name="vertical">Is the button taller than it is wide</param>
    ''' <param name="g">Graphics Object</param>
    ''' <param name="textRect">Rectangle defining the text area for the button</param>
    ''' <remarks></remarks>
    Private Sub WriteString(ByVal vertical As Boolean, ByVal g As Graphics, ByVal textRect As Rectangle)
        If (vertical) Then
            m_vs.Draw(g, m_buttonText, m_labelFont, m_labelBrush, textRect, m_labelStrFmt)
        Else
            g.DrawString(m_buttonText, m_labelFont, m_labelBrush, textRect, m_labelStrFmt)
        End If
    End Sub

    ''' <summary>
    ''' Convert horizontal alignment from ContentAlignment to StringAlignment
    ''' </summary>
    ''' <param name="ca"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function ConvertToHorAlign(ByVal ca As ContentAlignment) As StringAlignment
        If ((ca = ContentAlignment.TopLeft) Or (ca = ContentAlignment.MiddleLeft) Or (ca = ContentAlignment.BottomLeft)) Then
            Return StringAlignment.Near
        ElseIf ((ca = ContentAlignment.TopRight) Or (ca = ContentAlignment.MiddleRight) Or (ca = ContentAlignment.BottomRight)) Then
            Return StringAlignment.Far
        Else
            Return StringAlignment.Center
        End If
    End Function

    ''' <summary>
    ''' Convert vertical alignment from ContentAlignment to StringAlignment
    ''' </summary>
    ''' <param name="ca"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function ConvertToVertAlign(ByVal ca As ContentAlignment) As StringAlignment
        If ((ca = ContentAlignment.TopLeft) Or (ca = ContentAlignment.TopCenter) Or (ca = ContentAlignment.TopRight)) Then
            Return StringAlignment.Near
        ElseIf ((ca = ContentAlignment.BottomLeft) Or (ca = ContentAlignment.BottomCenter) Or (ca = ContentAlignment.BottomRight)) Then
            Return StringAlignment.Far
        Else
            Return StringAlignment.Center
        End If
    End Function

#End Region

#Region " Event Handlers "

    Protected Shadows Sub mouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        buttonDown()
    End Sub

    Protected Shadows Sub mouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        buttonUp()
    End Sub

    Protected Sub buttonDown()
        m_lightAngle = Angle.Down
        m_buttonPressOffset = 1
        Me.Invalidate()
    End Sub

    Protected Sub buttonUp()
        m_lightAngle = Angle.Up
        m_buttonPressOffset = 0
        Me.Invalidate()
    End Sub

    Protected Shadows Sub keyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
        If (e.KeyCode.ToString() = "Space") Then
            buttonDown()
        End If
    End Sub

    Protected Shadows Sub keyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
        If (e.KeyCode.ToString() = "Space") Then
            buttonUp()
        End If
    End Sub

    Protected Sub weGotFocus(ByVal sender As Object, ByVal e As System.EventArgs)
        m_gotFocus = True
        Me.Invalidate()
    End Sub

    Protected Sub weLostFocus(ByVal sender As Object, ByVal e As System.EventArgs)
        m_gotFocus = False
        buttonUp()
        Me.Invalidate()
    End Sub

#End Region

End Class
